COMMENT ⊗   VALID 00029 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	DEFINITIONS
 00008 00003	STORAGE ALLOCATIONS
 00012 00004	BEGIN OF MAIN PROGRAM
 00014 00005	FINISH READING IN FILES AND BEGIN COMPARING WORDS.SRT WITH DICT
 00017 00006	NXTMLT:	SETZM	MULFLG		set the MULFLG
 00022 00007	COUNT NUMBER OF LINKS LOST BY DELETING THIS KEYWORD
 00025 00008	deleting part of an entry..a brother or son
 00028 00009	INSERTION OF A NEW KEYWORD
 00031 00010	INS7:	MOVE	DPTR,MULKY
 00033 00011	INSINS:	MOVE	PPTR,[POINT 7,PARTS,35]	insert on something already moved
 00036 00012	INSFIN:	MOVEI	CHAR,CR			now put in CRLF
 00039 00013	DUNFWD:	MOVE	B,DPTR
 00042 00014	insert something..either a brother or son
 00047 00015	WRITIN:	MOVE	C,A		both C and A now point to the new word just insertedd
 00050 00016	NXTAT2:	JUMPE	CHAR,INSDUN		finished
 00053 00017	GETMLT:	MOVE	WSORT,PARTS(CNT)	SAVDIF expects this
 00055 00018	MOV1TM:	MOVE	LPTR,MPTR		save MPTR
 00057 00019	MOVAGN:	MOVE	A,DICT2(DBOT)	if -1, this entry was deleted. A table entry must be
 00060 00020	TABENT:	MOVNM	MPTR,TABLE(TPTR)make half of TABLE entry
 00064 00021	FIXING THE  LINKS AND DICT FILES
 00066 00022	RELEAS THE TMP FILES
 00068 00023	PRINT OUT THE OPTIONS
 00070 00024	RENAME THE TMP FILES
 00072 00025	RENAMING THE TMP FILES
 00074 00026	FINISH OF PROGRAM,SUBROUTINE EXAMIN,SETFLG
 00076 00027	SUBROUTINE GETSRT,ERROR,PAUSE
 00079 00028	COUNTL:	MOVEI	LINCNT,0	initialize the link count to zero
 00083 00029	GETDCT:	SETZ	RPTR,	initialize the retrieval pointer
 00086 ENDMK
⊗;
;DEFINITIONS
	TITLE MODIFY

TPTR←←1		;pointer into TABLE to fix up LINKS and DICT
DPTR←←2		;usually the current word in DICT
DBOT←←3		;usually the current destination in DICT2
DIFP←←4		;reg to hold a possibly different word for comparison
A←←4		;temporary reg
PPTR←←4		;byte pointer into the PARTS 
RPTR←←5		;retrieval pointer for MULKY
LINCNT←←6	;ac to count links
CHAR←←6		;where the byte pointers load into
DIFNO←←7	;difference between an entry's position in DICT and DICT2
KPTR←←7		;pointer into MULKY..always points to last word of multiple words
RECDIF←←7	;record difference,if DICT2 needs to move the MULTS down
MPTR←←10	;pointer into the MULT section of DICT
WPTR←←10	;pointer into WORDS
WSORT←←11	;ac to hold a SORTED word to compare with DIFP
INSPTR←←11	;byte pointer into WORDS.INS
DELPTR←←11	;byte pointer into WORDS.DEL
WBPTR←←12	;byte pointer into WORDS
B←←13		;temporary ac
TDIFP←←13	;a temporary DIFP
CPTR←←14	;pointer into old OCCUR.DAT
LPTR←←14	;pointer into LINKS
BPTR←←15	;holds backpointer into DICT from LINKS
C←←15		;temporary ac
MAXW←←15	;maximum length of the keywords
CBOT←←16	;pointer into new OCCUR.DAT
CNT←←16		;link counter
P←←17		;stack

WLEN←←6400
DLEN←←6000
MLEN←←=256
MULMAX←←=10
CLEN←←DLEN/2
DELLEN←←=200
INSLEN←←=200
LLEN←←10000
PDLEN←←=400

CR←←15
LF←←12

DEFINE	ERRMSG(MSG)
	{PUSHJ	P,[	MOVEM	A,SAVEDA
			MOVEI	A,[ASCIZ \MSG\]
			JRST	ERROR]}
;STORAGE ALLOCATIONS
RENADR:	0
	BLOCK	3

IBUF:	BLOCK	3

INSF:	SIXBIT	/WORDS/
	SIXBIT	/INS/
	BLOCK	2

DELF:	SIXBIT	/WORDS/
	SIXBIT	/DEL/
	BLOCK	2

LINKSF:	SIXBIT	/LINKS/
	BLOCK	3

WORDSF:	SIXBIT	/WORDS/
	BLOCK	3

DICTF:	SIXBIT 	/DICT/
	BLOCK	3

SORTF:	SIXBIT	/WORDS/
	SIXBIT	/SRT/
	BLOCK	2

OCCURF:	SIXBIT	/OCCUR/
	SIXBIT	/DAT/
	BLOCK	2
	
INDEXF:	SIXBIT	/INDEX/
	BLOCK	3

OLPART:	BLOCK	6	;holds first word of previous SORTED word
OLMLKY:	BLOCK	2	;holds address of last DICT entry
MULKY:	BLOCK	MULMAX	;holds addresses for each of the current DICT multiple words 
INS:	BLOCK	INSLEN	;WORDS.INS
DEL:	BLOCK	DELLEN	;WORDS.DEL
OCCUR:	BLOCK	CLEN	;old OCCUR.DAT
OCCUR2:	BLOCK	CLEN	;new OCCUR.DAT
LINKS:	BLOCK	LLEN
DICT:	BLOCK	DLEN	;old DICT
DICT2:	BLOCK	DLEN	;new DICT
TABLE:	BLOCK	=400	;TABLE for fixing the LINKS
PDLST:	BLOCK	PDLEN
WORDS:	BLOCK	WLEN

D2CMD:	IOWD	DLEN,DICT2
	0
O2CMD:	IOWD	CLEN,OCCUR2
	0
LCMD:	IOWD	LLEN,LINKS
	0
INSCMD:	IOWD	INSLEN,INS
	0
DELCMD:	IOWD	DELLEN,DEL
	0
OCMD:	IOWD	CLEN,OCCUR
	0
DCMD:	IOWD	0,DICT
	0
WCMD:	IOWD	WLEN,WORDS
	0

DCBOTM:	0		;end of DICT..place to add on MULTS
INSINF:	0		;flag indicating we just inserted a relative MULT to the current word
MOVED:	0		;already moved entry to DICT2
OCFLG:	0		;flag indicating there is an OCCUR.DAT
STAINF:	0		;flag indicating this is a "stationary insert"
OLMLFG:	0		;flag indicating last (old) key was a MULT
MULFLG:	0		;flag indicating this key is a MULT
LSTCNT:	0		;number of similar PARTS in two MULTS for writing into WORDS
CBOTM:	0		;storage for CBOT
DELPTM:	0		;storage for DELPTR
DIFNOM:	0		;storage for DIFNO
KPTRM:	0		;storage for KPTR
STOR2:	0		;temporary storage
STORAG:	0		;temporary storage
INSPTM:	0		;storage for INSPTR
MASK2:	374000000000	
SAVEDA:	0
STRNG:	BLOCK	 2
TOTCNM:	0		;total count number for counting links
SPACES:	100402010040
MASK:	7700000
PARTS:	BLOCK	=30	;storage for current SORTED word

DSK17:	17
	SIXBIT	/DSK/
	0
;BEGIN OF MAIN PROGRAM
MODIFY:	MOVE	P,[IOWD	PDLEN,PDLST]	;initialize push down list
	SETZ	KPTR,
	SETZM	OCFLG
MODIF:	OPEN	0,DSK17
	ERRMSG	{OPEN FAILED ON INDEX,FIRST AND ONLY TIME}
	SETZM	INDEXF+3
	SETZM	INDEXF+2
	SETZM	INDEXF+1
	ENTER	0,INDEXF
	JRST	PAUSE
	
	OPEN	1,DSK17		;read in all of WORDS
	ERRMSG	{OPEN FAILED ON WORDS}
	SETZM	WORDSF+3
	LOOKUP	1,WORDSF
	ERRMSG	{LOOKUP FAILED ON WORDS}
	IN	1,WCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON WORDS}
	RELEAS	1,

	INIT	2,0
	SIXBIT	/DSK/
	IBUF
	ERRMSG	{INIT FAILED ON WORDS.SRT FIRST TIME}
	SETZM	SORTF+3
	LOOKUP	2,SORTF
	ERRMSG	{LOOKUP FAILED ON WORDS.SRT}

	OPEN	4,DSK17		;read in the LINKS file
	ERRMSG	{OPEN FAILED ON LINKS}
	SETZM	LINKSF+1
	LOOKUP	4,LINKSF
	ERRMSG	{LOOKUP FAILED ON LINKS}
	IN	4,LCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON LINKS}
	RELEAS	4,


	OPEN	10,DSK17
	ERRMSG	{OPEN FAILED ON OCCUR.DAT}
	SETZM	OCCURF+3
	LOOKUP	10,OCCURF
	JRST	SETFG		;set flag if no OCCUR.DAT
	IN	10,OCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON OCCUR.DAT}
	RELEAS	10,
;FINISH READING IN FILES AND BEGIN COMPARING WORDS.SRT WITH DICT
DCONT:	OPEN	3,DSK17		;read in DICT
	ERRMSG	{OPEN FAILED ON DICT}
	SETZM	DICTF+3
	LOOKUP	3,DICTF
	ERRMSG	{LOOKUP FAILED ON DICT}
	HLLZ	A,DICTF+3
	HLLM	A,DCMD
	IN	3,DCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON DICT}
	RELEAS	3,

	MOVEI	DBOT,2		;destination of new DICT
	MOVEI	CBOT,1		;destination of new OCCUR.DAT
	MOVEM	CBOT,CBOTM
	SETZ	TPTR,		;pointer to TABLE to fix LINKS

	MOVEI	A,DLEN		;find end of DICT
COMBOT:	MOVE	B,DICT(A)
	JUMPN	B,BOTDUN
	SOJA	A,COMBOT	
BOTDUN:	SUBI	A,2
	MOVEM	A,DCBOTM

	SETZ	A,
	MOVEM	A,TABLE(TPTR)	;set initial two entries to TABLE to catch
	MOVEM	A,TABLE+1(TPTR)	;	the first entries that remain in the same
	ADDI	TPTR,2		;	place,(not offset because of insertions etc.)
	MOVEI	CPTR,1		;pointer into old OCCUR.DAT
	SETZ	DPTR,		;pointer into old DICT
	SETZM	DELPTM
	MOVE	A,[POINT 7,INS-1,35]
	MOVEM	A,INSPTM	;storage for pointer into WORDS.INS
	MOVEI	A,WLEN-1	;find the first vacant word in WORDs by searching
FINDPT:	SKIPN	WORDS(A)	;back from the end of the file
	SOJG	A,FINDPT
	MOVE	WBPTR,[POINT 7,WORDS,35];byte pointer into WORDS
	ADDI	WBPTR,(A)
	PUSHJ	P,GETSRT	;GETS RID OF LEADING CR-LF
NXTBOT:	PUSHJ	P,GETSRT	;get the first sorted word from SORT
NXTDCT:	MOVEI	CNT,1
	SETZ	RPTR,
	SETZM	INSINF
	PUSHJ	P,GETDCT
NXTMLT:	SETZM	MULFLG		;set the MULFLG
	JUMPE	KPTR,.+2
	SETOM	MULFLG
	MOVE	DPTR,MULKY(RPTR)
	HLRZ	WPTR,DICT(DPTR)	;get the DICT pointer into WORDS
	MOVE	DIFP,WORDS(WPTR);holds first part of word in WORDS

	CAME	DIFP,PARTS(CNT)	;same as first part of word in WORDS.SRT?
	JRST	SAVDF		;no, go save or delete the different word
	
	CAMN	DIFP,MASK2	;are the same words a question mark?
	JRST	PREFIX		;yes...we're done

NXT2:	ADDI	WPTR,1
	MOVE	DIFP,WORDS(WPTR)	;get the next part from WORDS
	ADDI	CNT,1
	CAMN	DIFP,PARTS(CNT)	;same as second part in WORDS.SRT?
	JRST	NXT2			;yes,continue
	MOVE	TDIFP,PARTS-1(CNT)
	TRNE	TDIFP,176		;no, was end of last part an @?
	JRST	SAVDF			;no. Words are different. Go insert or delete
	JRST	MOVDCT			;yes. Words are the same

;MOVING OF THE SAME DICT WORDS,EXAMINATION OF UNLIKE ONES
MOVDCT:	ADDI	CNT,1		;get the next part
	MOVE	TDIFP,PARTS(CNT)
	JUMPN	TDIFP,GETMLT	;end of words are marked by a null word
 	HRRE	TDIFP,DICT+1(DPTR);end of word..see if part matched so far is not
	JUMPL	TDIFP,STAINS	;a key because of a -1 in the field.
	MOVE	DPTR,MULKY	;set DPTR to the beginning of the key

	SKIPE	OCFLG
	JRST	OC1		;do following only if there is an OCCUR.DAT
	MOVE	A,OCCUR(CPTR)	;transfer one word of OCCUR.DAT
	MOVE	CBOT,CBOTM
	MOVEM	A,OCCUR2(CBOT)
	ADDI	CBOT,1		;increment pointers
	ADDI	CPTR,1
	MOVEM	CBOT,CBOTM

OC1:	MOVEM	DBOT,OLMLKY	;save current DBOT
	SETZM	OLMLKY+1	 
	SETZM	OLMLFG
	SKIPN	MOVED		;move the slot to DICT2 if it isn't already there
	PUSHJ	P,MOV
	JRST	NXTBOT		;return and get two new words to compare

SAVDF:	MOVE	WSORT,PARTS(CNT);SAVDIF requires that WSORT have the first

SAVDIF: JUMPL	DIFP,COMP1	;begin comparing to see if we insert or delete
	JUMPG	WSORT,COMP2
	JRST	INSERT		
COMP2:	CAMG	DIFP,WSORT	;we have numbers
	JRST	DELET
	JRST	INSERT
COMP1:	JUMPL	WSORT,COMP3	;DIFP is letters,
	JRST	DELET		;WSORT is numbers,and should have come earlier
COMP3:	CAMG	DIFP,WSORT	;two letters
	JRST	DELET
	JRST	INSERT
;COUNT NUMBER OF LINKS LOST BY DELETING THIS KEYWORD
DELET:	ADDI	CPTR,1		;delete this word from OCCUR.DAT
	MOVE	DPTR,MULKY(KPTR);get the pointer to the first word

	SKIPE	OLMLFG
	JRST	DELMUL
	SKIPE	MULFLG
	JRST	DELMUL
	MOVEM	KPTR,KPTRM	;the simple case...deleting non-MULTS
	MOVE	DIFNO,DIFNOM
	SUBI	DIFNO,2		;DICT2 entries after this will be moved two more..
	MOVNM	DPTR,TABLE(TPTR);so we store this information for the LINKS fixup
	MOVEM	DIFNO,TABLE+1(TPTR)
	MOVE	DELPTR,DELPTM	;get the pointer to  WORDS.DEL

	MOVEM	DIFNO,DIFNOM
	MOVE	KPTR,KPTRM	;get the KPTR back
	PUSHJ	P,COUNTL	;count the number of links lost
	ADDI	TPTR,2		;increment pointer into TABLE

	SETZM	OLMLFG		
	SKIPE	OLMLKY+1
	SETOM	OLMLFG	

	JRST	NXTDCT		;return and get the next DICT word
DELMUL:	HRRE	A,DICT+1(DPTR)	;see if this is a legal keyword
	JUMPGE	A,STADEL	
	HLRZ	A,DICT+1(DPTR)	;it's not..get the next word in the MULT
	JUMPN	A,DELA

	CAME	DPTR,MULKY	;there is no next word..this is a null entry
	JRST	DELM4		;it is not the first of the mults
	MOVEM	KPTR,KPTRM	;we are deleting a complete entry.
	MOVE	DIFNO,DIFNOM
	SUBI	DIFNO,2		;DICT2 entries after this will be moved two more..
	MOVNM	DPTR,TABLE(TPTR);so we store this information for the LINKS fixup
	MOVEM	DIFNO,TABLE+1(TPTR)
	MOVEM	DIFNO,DIFNOM
	ADDI	TPTR,2
	MOVE	KPTR,KPTRM
	SETZM	MULFLG

	SETZM	OLMLFG		;see if previous entry was a MULT
	SKIPE	OLMLKY+1
	SETOM	OLMLFG	
	PUSHJ	P,TEST3		;test to see if we've moved a now invalid key
	JRST	NXTDCT		;return to beginning for next keywords
;deleting part of an entry..a brother or son
DELM4:	HLRZ	A,DICT+2(DPTR)	;get the backpointer
	HRRZ	CNT,DICT+2(DPTR);get the brother
	HLRZ	TDIFP,DICT+1(A)	;get the son of the backpointer
	CAME	TDIFP,DPTR	;the same?
	JRST	DELM3		;no,pointed to byt the brother of the backpointer
	HRLM	CNT,DICT+1(A)	;yes..store the current brother
	JUMPN	CNT,DELM2	;if non-null,skip this
	SETOM	DICT(DPTR)	;delete the current slot
	MOVE	DPTR,A		;decreas the backpointer
	HRRE	B,DICT+1(DPTR)	;is this a valid keyword?
	JUMPL	B,DELMUL	;no, and CNT could be zero.return possibly to delete again
	PUSHJ	P,TEST3		;yes, so see if the DICT2 (moved) version is still valid

;deleting a brother
DELM3:	HRRM	CNT,DICT+2(A)	;get the brother of the current key
DELM2:	HRLM	A,DICT+2(CNT)	;make it the brother of the backpointer
	SETOM	DICT(DPTR)	;delete this entry
	JRST	NXTDCT		;return for the next DICT

DELA:	MOVE	DPTR,A		;get the next of word in this key
	JRST	DELMUL

;deleting a valid keyword by inserting a -1 in the links pointer
STADEL:	MOVE	DELPTR,DELPTM	;get the pointer to WORDS.DEL
	PUSHJ	P,COUNTL	;count the number of links lost
	MOVEI	A,-1		
	HRRM	A,DICT+1(DPTR)	;set the flag indicating not a valid keyword
	HLRZ	A,DICT+1(DPTR)	;see if this key has a son
	JUMPE	A,DELMUL	;no..go back and erase this entry
	JRST	NXTDCT		;yes..the entry must stay. Start over with a new DICT word
;INSERTION OF A NEW KEYWORD
INSERT:	SKIPE	OCFLG
	JRST	OC2
	MOVE	CBOT,CBOTM	;increment CBOT indicating a keyword of count zero
	SETZM	OCCUR2(CBOT)
	ADDI	CBOT,1
	MOVEM	CBOT,CBOTM
OC2:	SKIPE	MULFLG
	JRST	INSMUL
	SKIPE	OLMLFG
	JRST	INSMUL

;simple insertion of a non-MULT..maybe
	MOVE	A,DBOT		;get the last moved entry
	SUBI	A,2
	HLRZ	WPTR,DICT2(A)	;get the pointer to the first word of the last entry
	SETZ	CNT,
CKWRDT:	MOVE	WSORT,WORDS(WPTR);get the first word of the last entry
	ADDI	CNT,1
	CAMN	WSORT,PARTS(CNT);compare it with the current (inserted) word
	AOJA	WPTR,CKWRDT	;same,get next 5 char
SAMLTT:	CAIN	CNT,1		;see if the first word was indeed the same
	JRST	SAMNO		;no
	MOVE	WSORT,WORDS-1(WPTR);maybe
	TRNE	WSORT,176
	JRST	SAMNO
	SETOM	MOVED		;yes
	SETOM	INSINF
	SETOM	OLMLFG
	JRST	INSINS

SAMNO:	MOVEM	DBOT,OLMLKY		;keep OLMLKY up to date
	SETZM	OLMLKY+1
	SETZM	DICT2+1(DBOT)		;wipe out the right half of the next slot
	HRRZ	A,WBPTR			;get the pointer to where the word will go
	SUBI	A,WORDS-1		;make the pointer relative to WORDS
	HRLZM	A,DICT2(DBOT)		;store pointer into words in DICT
	SETO	A,			;make all insertions invalid until the last
	HRRM	A,DICT2+1(DBOT)		;word of the MULT is inserted

	ADDI	DBOT,2			;increment DBOT
	SETOM	MOVED			;entry is in DICT2
INS7:	MOVE	DPTR,MULKY
	MOVNM	DPTR,TABLE(TPTR)	;store negative pointer to DICT in TABLE

	MOVEM	KPTR,KPTRM
	MOVE	DIFNO,DIFNOM
	ADDI	DIFNO,2			;and the difference is getting smaller
	MOVEM	DIFNO,TABLE+1(TPTR)	;store for use in moving LINKS
	MOVEM	DIFNO,DIFNOM
	MOVE	KPTR,KPTRM

	ADDI	TPTR,2	
	MOVE	PPTR,[POINT 7,PARTS,35]	;byte pointer into PARTS
	ILDB	CHAR,PPTR		;get a character from PARTS+1
	MOVE	INSPTR,INSPTM		;set up the byte pointer into WORDS.INS
	CAIN	CHAR,"@"		;end of word?
	JRST	DEP100			;yes..prepare to dep100
DEPBYT:	IDPB	CHAR,WBPTR		;no, deposit the char and continue
	IDPB	CHAR,INSPTR		;deposit into WORDS.INS
	ILDB	CHAR,PPTR		;get next char
	CAIE	CHAR,"@"		;is it an @?
	JRST	DEPBYT			;no, continue
DEP100:	IDPB	CHAR,WBPTR		;yes,prepare to deposit @ signs
	TLNE	WBPTR,760000		;finished with this word?
	JRST	DEP100			;no
	HRRZ	B,WBPTR			;yes...see if we've run out of room in WORDS
	SUBI	B,WORDS
	CAIL	B,WLEN
	ERRMSG	{WORDS IS TOO SMALL}
	HRRZ	CNT,PPTR		;get the current PART number
	SUBI	CNT,PARTS-2		;relative to PARTS+1
	MOVEM	CNT,LSTCNT		;this much is identical to the previous entry

	JRST	EATUM			;eat up the @'s
INSINS:	MOVE	PPTR,[POINT 7,PARTS,35]	;insert on something already moved
	ILDB	CHAR,PPTR	;get a char from PARTS
	MOVE	INSPTR,INSPTM	;get the pointer to WORDS.INS
INSIN3:	IDPB	CHAR,INSPTR	;deposit the char
	ILDB	CHAR,PPTR	;get another
	CAIE	CHAR,"@"	;end of word?
	JRST	INSIN3		;no, repeat
EATUM:	ILDB	CHAR,PPTR	;yes.fill out the word with @'s
	CAIN	CHAR,"@"
	JRST	EATUM
	JUMPE	CHAR,INSFIN	;if it is zero we are done

	SETOM	OLMLKY+1	;we have a multiple word
	SETOM	OLMLFG
	SKIPE	INSINF		;if we are inserting on a word already moved,go to DUNFWD
	JRST	DUNFWD
	MOVE	B,DBOT		;otherwise get the last word moved
	SUBI	B,2

	MOVE	C,DCBOTM	;get the next slot for insertion
	ADDI	C,3
	MOVEM	C,DCBOTM

	HRLM	C,DICT2+1(B)	;DICT2 of the last entry gets the new slot
	JRST	.+2
MLTIN2:	HRLM	C,DICT+1(B)	;B=OLD DICT POINTER TO MULT..,C= NEW POINTER
	HRLM	B,DICT+2(C)	;store the backpointer

	MOVEI	B," "		;put the space in WORDS.INS
	IDPB	B,INSPTR
MULTIN:	HRRZ	B,WBPTR		;check to see if there is still room in WORDS
	SUBI	B,WORDS-1
	CAILE	B,WLEN
	ERRMSG	{WORDS IS TOO SMALL}
	HRLZM	B,DICT(C)	;store pointer to words
	SETO	B,		;make all keywords invalid until the last one
	HRRM	B,DICT+1(C)
	
DEPMUL:	IDPB	CHAR,WBPTR	;deposit the chars until end of word
	IDPB	CHAR,INSPTR
	ILDB	CHAR,PPTR
	CAIE	CHAR,"@"
	JRST	DEPMUL
DEPA:	IDPB	CHAR,WBPTR	;finish out the word with @'s
	TLNE	WBPTR,760000	
	JRST	DEPA
EATUM2:	ILDB	CHAR,PPTR	;eat the @'s from the parts
	CAIN	CHAR,"@"
	JRST	EATUM2
	JUMPE	CHAR,INSDUN	;finished if CHAR = 0

	MOVE	B,C		;not done. Get another available insert slot and repeat
	MOVE	C,DCBOTM
	ADDI	C,3
	MOVEM	C,DCBOTM
	JRST	MLTIN2
INSFIN:	MOVEI	CHAR,CR			;now put in CRLF
CHAN1:	HLLZS	DICT2-1(DBOT)		;make keyword valid by zeroing the -1
	IDPB	CHAR,INSPTR		;put CRLF in WORDS.INS
	MOVEI	CHAR,LF
	IDPB	CHAR,INSPTR
	MOVEM	INSPTR,INSPTM		;save INSPTR in memory
	PUSHJ	P,GETSRT		;get the next SORTED word
	SETZ	CNT,			;reset pointers and counters
	SETZ	RPTR,
	SETOM	OLMLFG
	AOJA	CNT,NXTMLT		;go back to compare new word to old DICT word
;STATIONARY INSERT CONSISTING OF ZEROING A -1 FLAG
STAINS:	MOVEI	A,=100		;set A past all possible parts
	MOVEM	A,LSTCNT
	MOVE 	CBOT,CBOTM	;increment CBOT indicating an insertion has been made
	SETZM	OCCUR2(CBOT)
	ADDI	CBOT,1
	MOVEM	CBOT,CBOTM
	SETZ	A,
	HRRM	A,DICT+1(DPTR)	;zero the -1, making this keyword valid
	MOVE	A,DPTR		;get the pointer to this word of the MULT
	SETOM	STAINF		;set the staionary insert flag
	JRST	WRITE2		;write this word in WORDS.INS

INSMUL:	SKIPE	MULFLG
	JRST	INSCON

;checking to see if we should insert on the end of the previous mult
INSLST:	MOVE	DPTR,DBOT	;get the previous entry
	SUBI	DPTR,2
	HLRZ	WPTR,DICT2(DPTR);get the pointer to words
	SETOM	MOVED		;set various flags
	SETZM	OLMLFG
	SETOM	MULFLG
	SETOM	INSINF
	SETZ	CNT,
	JRST	CKWRD		;go see if they are the same
INSCON:	MOVE	DPTR,MULKY	;get the first word of the current DICT word
	SETZ	CNT,
	HLRZ	WPTR,DICT(DPTR)	;get the pointer into WORDS
CKWRD:	MOVE	WSORT,WORDS(WPTR);see if the words are identical
	ADDI	CNT,1
	CAMN	WSORT,PARTS(CNT)
	AOJA	WPTR,CKWRD
SAMMLT:	CAIN	CNT,1		
	JRST	.+4		;first words are not the same
	MOVE	WSORT,WORDS-1(WPTR)
	TRNN	WSORT,176
	JRST	DUNFWD
	SKIPN	MULFLG		;not the same..straight insertion required
	SETZM	MOVED
	SETZM	OLMLFG
	SETZM	MULFLG
	JRST	OC2
	
DUNFWD:	MOVE	B,DPTR
	HLRZ	A,DICT+1(DPTR)	;get the pointer to the son
	SKIPE	INSINF		
	HLRZ	A,DICT2-1(DBOT)
	SETZM	INSINF
	CAIN	A,0
	JRST	INS1SN		;no son..go insert the first son
	ADDI	CNT,1
CKWRD3:	HLRZ	WPTR,DICT(A)	;see if the son also matches the current (inserted)word
	MOVEM	CNT,LSTCNT	;they are the same up to this point
CKWRD2:	MOVE	WSORT,WORDS(WPTR)
	CAME	WSORT,PARTS(CNT)
	JRST	GETBRO		;not the same but maybe the brother matches
	ADDI	CNT,1	
	ADDI	WPTR,1
CKWRD4:	MOVE	WSORT,WORDS(WPTR);compare the next parts as above
	CAME	WSORT,PARTS(CNT)
	JRST	DIFRNT		;not the same
	ADDI	CNT,1	
	AOJA	WPTR,CKWRD4
DIFRNT:	MOVE	WSORT,WORDS-1(WPTR);see if the last word ends in @
	TRNN	WSORT,176
	AOJA	CNT,GETSON	;it does, get the next son and repeat

GETBRO:	MOVE	WSORT,WORDS(WPTR)
	CAME	WSORT,PARTS(CNT);finish examining this word as far as they are equal
	JRST	GETB2
	ADDI	WPTR,1
	AOJA	CNT,GETBRO
GETB2:	CAML	WSORT,PARTS(CNT);see if we really should get the next brother
	JRST	INSSOM		;or really insert a new one right here
	MOVE	B,A		;B holds the last word tried
	HRRZ	A,DICT+2(A)	;A gets the brother pointer
	JUMPE	A,INSBRO	;if null, insert a brother
	MOVE	CNT,LSTCNT	;set CNT to last identical part
	JRST	CKWRD3		;return

GETSON:	MOVEM	CNT,LSTCNT	;words identical up to this point
	MOVE	DPTR,A		;DPTR is the last father
	MOVE	B,A		;B is the last brother
	HLRZ	A,DICT+1(DPTR)	;A gets the son pointer
	JUMPE	A,INSSON	;if null, go insert a son
	JRST	CKWRD3

;insert something..either a brother or son
INSSOM:	HLRZ	C,DICT+2(A)	;get the backpointer
	CAML	C,MULKY		;see if it has been moved already
	JRST	INSS2
	HLRZ	C,DICT2+1(C)
	JRST	INS1SN
INSS2:	HLRZ	C,DICT+1(C)	;get the son pointer
	CAMN	C,A		;see if it points to the current word
	JRST	INSSON		;it does..insert a son

INSBRO:	HRRZ	DPTR,DICT+2(B)	;DPTR← brother of last word
	MOVE	A,DCBOTM	;A←new slot for inserted word
	ADDI	A,3
	MOVEM	A,DCBOTM
	HRRM	A,DICT+2(B)	;last word now points to inserted word
	HRLM	B,DICT+2(A)	;inserted word now points back to last bro
	JUMPE	DPTR,WRITIN	;if no more brothers, we are really done
	HRLM	A,DICT+2(DPTR)	;next brother now points back to the inserted word
	HRRM	DPTR,DICT+2(A)	;the inserted brother now points to the next brother
	JRST	WRITIN		;go make text entries

INSSON:	HLRZ	B,DICT+1(DPTR)	;B←last son of father,soon to be new brother
	MOVE	A,DCBOTM	;A←inserted son
	ADDI	A,3
	MOVEM	A,DCBOTM
	HRLM	A,DICT+1(DPTR)	;father now points to new son
	HRRM	B,DICT+2(A)	;new son now points to new brother(old son)
	HRLM	DPTR,DICT+2(A)	;new son now points back to father
	JUMPE	B,WRITIN	;if no new brother, we are done
	HRLM	A,DICT+2(B)	;new brother now points back to inserted new son
	JRST	WRITIN		;go make WORDS.INS entries

INS1SN:	SUBI	DBOT,2		;get the last moved entry
	HLRZ	B,DICT2+1(DBOT)	;B←son of last father
	MOVE	A,DCBOTM	;A ← inserted word
	ADDI	A,3
	MOVEM	A,DCBOTM
	HRLM	A,DICT2+1(DBOT)	;father now points to new son
	HRLM	DBOT,DICT+2(A)	;new son now points to father
	ADDI	DBOT,2	
	HRRM	B,DICT+2(A)	;as above
	JUMPE	B,WRITIN
	HRLM	A,DICT+2(B)
	JRST	WRITIN
WRITIN:	MOVE	C,A		;both C and A now point to the new word just insertedd
	SETO	B,
	HRRM	B,DICT+1(C)	;make it invalid
	HRRZ	B,WBPTR		;get the pointer into WORDS
	SUBI	B,WORDS-1
	HRLM	B,DICT(A)	;store it in the new word

WRITE2:	MOVE	PPTR,[POINT 7,PARTS,35]
	ILDB	CHAR,PPTR		;get a character from PARTS+1
	MOVE	INSPTR,INSPTM		;set up the byte pointer into WORDS.INS
	CAIN	CHAR,"@"		;end of word?
	ERRMSG	{TRYING TO INSERT WORD BEGINNING WITH @}
DPBYT2:	HRRZ	B,PPTR
	SUBI	B,PARTS
	CAML	B,LSTCNT		;up to this point is already in WORDS
	IDPB	CHAR,WBPTR		;deposit the char and continue
	IDPB	CHAR,INSPTR		;deposit into WORDS.INS
	ILDB	CHAR,PPTR		;get next char
	CAIE	CHAR,"@"		;is it an @?
	JRST	DPBYT2			;no, continue

	SKIPE	STAINF			;don't want to put @'s in WORDS if it is a
	JRST	NXTAT			;stationary insert or if we havn't reached the
	CAMGE	B,LSTCNT		;point of any change in the DICT
	JRST	NXTAT

DP1002:	IDPB	CHAR,WBPTR		;yes,prepare to deposit @ signs
	TLNE	WBPTR,760000		;finished with this word?
	JRST	DP1002			;no
NXTAT:	ILDB	CHAR,PPTR		;eat up all the @'s
	CAIN	CHAR,"@"
	JRST	NXTAT

	SKIPN	STAINF
	JRST	NXTAT2
	JUMPE	CHAR,INSDUN		;finished
	MOVEI	B," "			;put the space in WORDS.INS
	IDPB	B,INSPTR
	JRST	DPBYT2			;go back and deposit the next word

NXTAT2:	JUMPE	CHAR,INSDUN		;finished
	MOVEM	PPTR,STORAG		;save PPTR

	MOVEI	A," "			;put the space in WORDS.INS
	IDPB	A,INSPTR
	MOVE	PPTR,STORAG
	CAMGE	B,LSTCNT		;see if we have finished the identical part of
	JRST	DPBYT2			;the new word

	MOVE	C,DCBOTM		;yes. an entry must be made
	MOVE	A,C			;A is the last inserted word
	ADDI	C,3			;C is the new spot
	HRLM	A,DICT+2(C)		;WHAT IF A ISN'T RELATED TO C?
	HRLM	C,DICT+1(A)		;and A now points to C
	SETO	A,
	HRRM	A,DICT+1(C)		;make it invalid
	HRRZ	A,WBPTR			;put the pointer into WORDS in the new word
	SUBI	A,WORDS-1
	HRLZM	A,DICT(C)

	MOVEM	C,DCBOTM		
	MOVE	PPTR,STORAG
	JRST	DPBYT2			;go write out this word

INSDUN:	SKIPN	STAINF
	HLLZS	DICT+1(C)		;make this key valid
	HRRZ	A,WBPTR			;see if we've run out of room in WORDS
	SUBI	A,WORDS
	CAIL	A,WLEN
	ERRMSG	{WORDS IS TOO SMALL}

	MOVEI	CHAR,CR			;now put in CRLF
	IDPB	CHAR,INSPTR
	MOVEI	CHAR,LF
	IDPB	CHAR,INSPTR
	MOVEM	INSPTR,INSPTM		;save INSPTR in memory

	SKIPE	MOVED			;either MOVE the last entry or TEST3 it to see
	JRST	.+3			;if the moved version is still valid
	PUSHJ	P,MOV
	JRST	.+2
	PUSHJ	P,TEST3
	PUSHJ	P,GETSRT		;get the next SORTED word
	SETOM	OLMLFG			;this is a MULT
	SETZ	RPTR,
	SETZM	STAINF
	MOVEI	CNT,1
	JRST	NXTMLT			;go back and compare the new word with the old DICT
GETMLT:	MOVE	WSORT,PARTS(CNT)	;SAVDIF expects this
	SKIPN	MULFLG		;no more MULTS..go delete something
	JRST	DELMUL
	ADDI	RPTR,1		;increment the retrieval pointer
	CAMG	RPTR,KPTR	;see if it has passed KPTR
	JRST	NXTMLT		;no, go back and compare
	JRST	SAVDIF		;yes.The keys are different.
;CONTINUE BUILDING THE TABLE, INCLUDING THE MULTIPLE WORDS NOW

PREFIX:	MOVE	A,DICT(DPTR)		;move question mark
	MOVEM	A,DICT2(DBOT)
	MOVE	A,DICT+1(DPTR)
	MOVEM	A,DICT2+1(DBOT)
	MOVEM	DBOT,STORAG

	MOVE	A,DCBOTM		;set second word past last entry to ones
	ADDI	A,3
	MOVEM	A,DCBOTM
	SETOM	DICT(A)
	SETOM	DICT+1(A)

	SKIPE	OCFLG
	JRST	OC3
	MOVE	A,OCCUR(CPTR)		;move OCCUR.DAT's question mark
	MOVE	CBOT,CBOTM
	MOVEM	A,OCCUR2(CBOT)

OC3:	MOVE	RPTR,DBOT		;DBOT becomes the next record boundary..
	ADDI	DBOT,1			;where the mults will go
ZERMLT:	SETZM	DICT2(DBOT)
	TRNE	DBOT,177
	AOJA	DBOT,ZERMLT

FIGDIF:	MOVE	MPTR,DPTR		;MPTR is set to the beginning of the the mults
	ADDI	MPTR,1			;in DICT
ZERCNT:	MOVE	A,DICT(MPTR)
	JUMPN	A,MLCNDN
	AOJA	MPTR,ZERCNT

MLCNDN:	MOVE	RECDIF,DBOT		;we get the difference in the beginnings of the
	SUB	RECDIF,MPTR		;two areas for the mults

MOV1TM:	MOVE	LPTR,MPTR		;save MPTR
	MOVE	C,DBOT
	ADDI	C,=128			;in order to insert words, the first move is
	ADDI	RECDIF,=128		;to an area one record off from the correct position
MOVIT:	MOVE	A,DICT(MPTR)		;move all mults from DICT to DICT2, changing
	JUMPE	A,SKIPBL		;appropriate pointers by the RECDIF
	MOVEM	A,DICT2(C)
	MOVE	A,DICT+1(MPTR)
	JUMPL	A,PREMOV		;the end is marked with 7's
	HLRZ	A,DICT+1(MPTR)
	JUMPE	A,.+2
	ADD	A,RECDIF
	HRLM	A,DICT2+1(C)		;son pointer
	HRRZ	A,DICT+1(MPTR)
	HRRM	A,DICT2+1(C)

	HLRZ	A,DICT+2(MPTR)		;back pointer
	JUMPE	A,MOV5

	CAML	A,LPTR			;don't increment if not in MULTS
	ADD	A,RECDIF
MOV5:	HRLM	A,DICT2+2(C)
	HRRZ	A,DICT+2(MPTR)
	JUMPE	A,.+2
	ADD	A,RECDIF
	HRRM	A,DICT2+2(C)
	
	ADDI	MPTR,3
	ADDI	C,3
	JRST	MOVIT
SKIPBL:	ADDI	MPTR,1			;skip the blank words before a new record
	AOJA	C,MOVIT
PREMOV:	SETOM	DICT2+1(C)	;set flag indicating end of MULTS
	ADDI	C,3		;save end
	MOVEM	C,STOR2
	SUBI	RECDIF,=128	;prepare to move MULTS into correct position
	MOVE	MPTR,LPTR
	MOVNM	MPTR,TABLE(TPTR);make TABLE entries
	MOVEM	RECDIF,TABLE+1(TPTR)

	ADDI	TPTR,2
	MOVE	DPTR,DBOT	;move words from DBOT to DPTR
	ADDI	DBOT,=128

MOVAGN:	MOVE	A,DICT2(DBOT)	;if -1, this entry was deleted. A table entry must be
	JUMPLE	A,TABENT	;made and the pointers incremented
	MOVEM	A,DICT2(DPTR)
	HLRZ	A,DICT2+1(DBOT)	;get son pointer
	HRLM	A,DICT2+1(DPTR)
	CAML	A,LPTR
	HRLM	DPTR,DICT2+2(A)	;if son is a MULT, correct the son backpointer
MCON1:	HRRZ	A,DICT2+1(DBOT)	;links pointer
	HRRM	A,DICT2+1(DPTR)
	HLRZ	A,DICT2+2(DBOT)	;backpointer
	HRLM	A,DICT2+2(DPTR)
	CAMG	A,LPTR
	JRST	MCON2
	HLRZ	B,DICT2+1(A)	;if backpointer points to a mult,see if it is pointed
	CAMN	DBOT,B		;to by the son or brother, and correct the correct pointer
	JRST	.+3
	HRRM	DPTR,DICT2+2(A)
	JRST	MCON2
	HRLM	DPTR,DICT2+1(A)
MCON2:	HRRZ	A,DICT2+2(DBOT)	;brother pointer
	HRRM	A,DICT2+2(DPTR)
	CAML	A,LPTR
	HRLM	DPTR,DICT2+2(A)	;if it points to a MULT, correct the backpointer
MCON3:	ADDI	DBOT,3		;increment the pointers
	ADDI	MPTR,3
	SETZ	B,

	ADDI	DPTR,3		;check to see if next entry will have a record boundary
	MOVE	A,DPTR
MCON4:	TRNN	A,177
	JRST	ADVNCE
	ADDI	A,1
	ADDI	B,1
	TRNN	A,177
	JRST	ADVNCE
	ADDI	A,1
	ADDI	B,1
	TRNE	A,177
	JRST	MOVAGN

ADVNCE:	ADD	RECDIF,B	;yes,so leave some unused slots, make a TABLE entry
	MOVNM	MPTR,TABLE(TPTR)
	MOVEM	RECDIF,TABLE+1(TPTR)
	ADDI	TPTR,2
	MOVE	DPTR,A
	JRST	MOVAGN

TABENT:	MOVNM	MPTR,TABLE(TPTR);make half of TABLE entry
	SETZ	B,
TAB2:	JUMPE	A,TAB3		;if passing blanks, go to TAB3
;passing deleted words
TAB4:	MOVE	A,DICT+1(MPTR)	;see if this is the end of MULTS
	JUMPL	A,PRE2
	ADDI	B,3		;no,increment pointers
	ADDI	DBOT,3
	ADDI	MPTR,3
	MOVE	A,DICT(MPTR)	;get next slot
	JUMPL	A,TAB4		;also deleted
	JUMPE	A,TAB3		;skipping blanks
TAB5:	SUB	RECDIF,B	;regular slot coming up. Update RECDIF
	MOVEM	RECDIF,TABLE+1(TPTR);make TABLE entry
	ADDI	TPTR,2
	JRST	MOVAGN
;skipping zeros
TAB3:	ADDI	B,1		;increment past one blank word
	ADDI	DBOT,1		;until we hit a record boundary
	ADDI	MPTR,1
	TRNE	DBOT,177
	JRST	TAB3
	JRST	TAB5

PRE2:	SETZM	DICT2(DPTR)
	TRNE	DPTR,177
	AOJA	DPTR,PRE2
PRE4:	SUBI	DPTR,1
	TRC	DPTR,777777
	HRLM	DPTR,D2CMD

	MOVNM	MPTR,TABLE(TPTR)	;make final TABLE entry

	OPEN	11,DSK17
	ERRMSG	{OPEN FAILED ON DELETE}
	SETZM	DELF+2
	SETZM	DELF+3
	ENTER	11,DELF
	ERRMSG	{ENTER FAILED ON WORDS.DEL}
	OUT	11,DELCMD		;output WORDS.DEL
	JRST	.+2
	ERRMSG	{OUT FAILED ON WORDS.DEL}
	RELEAS	11,

	OPEN	12,DSK17
	ERRMSG	{OPEN FAILED ON WORDS.INS}
	SETZM	INSF+2
	SETZM	INSF+3
	ENTER	12,INSF
	ERRMSG	{ENTER FAILED ON WORDS.INS}
	OUT	12,INSCMD		;output WORDS.INS
	JRST	.+2
	ERRMSG	{OUT FAILED ON WORDS.INS}
	RELEAS	12,
;FIXING THE  LINKS AND DICT FILES
CHAND2:	SETZ	DPTR,			;now we change the pointers from DICT into MULTS
	MOVE	RPTR,STORAGE
CHAND3:	ADDI	DPTR,2
	CAML	DPTR,RPTR
	JRST	FIXLIN
HAND2:	HLRZ	A,DICT2+1(DPTR)		;get pointer into MULTS
	JUMPE	A,CHAND3		;no pointer
	MOVN	C,A
	SETZ	TPTR,
CHAN3:	CAMLE	C,TABLE(TPTR)		;find correct TABLE entry
	JRST	FNDDN
	ADDI	TPTR,2
	JRST	CHAN3

FNDDN:	MOVE	B,TABLE-1(TPTR)		;increment the pointer by the accompanying DIFNO
	ADD	A,B
	HRLM	DPTR,DICT2+2(A)		;correct both pointers
	HRLM	A,DICT2+1(DPTR)
	JRST	CHAND3



FIXLIN:	MOVEI	LPTR,0		;initialize links pointer
FIX2:	ADDI	LPTR,2		;pointer to link
	CAIL	LPTR,LLEN	;if there is none, we're done
	JRST	DONE
	HRRE	BPTR,LINKS(LPTR)
 	JUMPG	BPTR,FIX2	;if negative, we must change it
	SETZ	TPTR,		;prepare to search the TABLE
FINDIF:	CAMLE	BPTR,TABLE(TPTR);find first pointer in DICT that is greater
	JRST	FNDDNO		;found it
	ADDI	TPTR,2		;keep looking
	JRST	FINDIF

FNDDNO:	MOVE	A,TABLE-1(TPTR)	;now get the number this must be altered
	SUB	BPTR,A		;change it 
	HRRM	BPTR,LINKS(LPTR);store it
	JRST	FIX2		;go back for more
;RELEAS THE TMP FILES
DONE:	OPEN	5,DSK17		
	ERRMSG	{SECOND OPEN FAILED ON DICT}
	MOVEI	A,'TMP'	
	HRLZM	A,DICTF+1
	SETZM	DICTF+2
	SETZM	DICTF+3
	ENTER	5,DICTF
	ERRMSG	{ENTER FAILED ON DICT}

	SKIPE	OCFLG
	JRST	OC4
	OPEN	10,DSK17		
	ERRMSG	{SECOND OPEN FAILED ON OCCUR.DAT}
	MOVEI	A,'TMP'
	HRLZM	A,OCCURF+1
	SETZM	OCCURF+2
	SETZM	OCCURF+3
	ENTER	10,OCCURF
	ERRMSG	{ENTER FAILED ON OCCUR.DAT}

OC4:	OPEN	7,DSK17		
	ERRMSG	{SECOND OPEN FAILED ON WORDS}
	MOVEI	A,'TMP'
	HRLZM	A,WORDSF+1
	SETZM	WORDSF+2
	SETZM	WORDSF+3
	ENTER	7,WORDSF
	ERRMSG	{ENTER FAILED ON WORDS}

	OPEN	6,DSK17		
	ERRMSG	{SECOND OPEN FAILED ON LINKS}
	MOVEI	A,'TMP'
	HRLZM	A,LINKSF+1
	SETZM	LINKSF+2
	SETZM	LINKSF+3
	ENTER	6,LINKSF
	ERRMSG	{ENTER FAILED ON LINKS}

	OUT	5,D2CMD
	OUT	6,LCMD
	OUT	7,WCMD
	SKIPE	OCFLG
	JRST	CON4
	OUT	10,O2CMD
	RELEAS	10,
CON4:	RELEAS	7,
	RELEAS	6,
	RELEAS	5,
;PRINT OUT THE OPTIONS
	MOVE	A,SPACES		;change LINCNT to ascii to output the
	MOVE	LINCNT,TOTCNM		;number of links that will be lost
	IDIVI	LINCNT,=10
	ADDI	LINCNT+1,60
	TRZ	A,40
	ADDI	A,(LINCNT+1)
	JUMPE	LINCNT,DONE3
	ROT	A,-7
	IDIVI	LINCNT,=10
	ADDI	LINCNT+1,60
	TRZ	A,40
	ADDI	A,(LINCNT+1)
	JUMPE	LINCNT,DONE0
	ADDI	LINCNT,60
	ROT	A,-7
	TRZ	A,40
	ADDI	A,(LINCNT)
DUN00:	ROT	A,7
DONE0:	ROT	A,7
DONE3:	LSH	A,1
	OUTSTR	[ASCIZ /
/]
	MOVEM	A,STRNG
	OUTSTR	STRNG
	OUTSTR	[ASCIZ / LINKS WILL BE LOST. SHOULD I CONTINUE? /]
	INCHWL	CHAR
	CAIE	CHAR,"Y"
	CAIN	CHAR,"y"
	JRST	INCH
	JRST	FINISH
INCH:	INCHWL	CHAR
	CAIE	CHAR,LF
	JRST	INCH
;RENAME THE TMP FILES
	OPEN	6,DSK17
	ERRMSG	{OPEN FAILED ON LINKS}
	SETZM	LINKSF+1
	SETZM	LINKSF+3
	LOOKUP	6,LINKSF
	ERRMSG	{LOOKUP FAILED ON LINKS PAGE 10}
	RENAME	6,RENADR
	ERRMSG	{RENAME FAILED ON LINKS}
	RELEAS	6,

	OPEN	5,DSK17
	ERRMSG	{OPEN FAILED ON DICT}
	SETZM	DICTF+1
	SETZM	DICTF+3
	LOOKUP	5,DICTF
	ERRMSG	{LOOKUP FAILED ON DICT PAGE 10}
	RENAME	5,RENADR
	ERRMSG	{RENAME FAILED ON DICT}
	RELEAS	5,

	OPEN	7,DSK17
	ERRMSG	{OPEN FAILED ON WORDS}
	SETZM	WORDSF+1
	SETZM	WORDSF+3
	LOOKUP	7,WORDSF
	ERRMSG	{LOOKUP FAILED ON WORDS PAGE 10}
	RENAME	7,RENADR
	ERRMSG	{RENAME FAILED ON WORDS}
	RELEAS	7,

	SKIPE	OCFLG
	JRST	FINCON
	OPEN	10,DSK17
	ERRMSG	{OPEN FAILED ON OCCUR.DAT}
	MOVEI	A,'DAT'
	HRLZM	A,OCCURF+1
 	SETZM	OCCURF+3
	LOOKUP	10,OCCURF
	ERRMSG	{LOOKUP FAILED ON OCCUR.DAT PAGE 10}
	RENAME	10,RENADR
	ERRMSG	{RENAME FAILED ON OCCUR.DAT}
	RELEAS	10,
;RENAMING THE TMP FILES
	OPEN	10,DSK17
	ERRMSG	{OPEN FAILED ON OCCUR.DAT}
	MOVEI	A,'TMP'
	HRLZM	A,OCCURF+1
	SETZM	OCCURF+3
	LOOKUP	10,OCCURF
	ERRMSG	{LOOKUP FAILED ON OCCUR.TMP PAGE 10}
	MOVEI	A,'DAT'
	HRLZM	A,OCCURF+1
	SETZM	OCCURF+2
	SETZM	OCCURF+3
	RENAME	10,OCCURF
	ERRMSG	{RENAME FAILED ON OCCUR.TMP}
	RELEAS	10,

FINCON:	OPEN	6,DSK17
	ERRMSG	{OPEN FAILED ON LINKS}
	MOVEI	A,'TMP'
	HRLZM	A,LINKSF+1
	SETZM	LINKSF+3
	LOOKUP	6,LINKSF
	ERRMSG	{LOOKUP FAILED ON LINKS.TMP PAGE 10}
	SETZM	LINKSF+1
	SETZM	LINKSF+2
	SETZM	LINKSF+3
	RENAME	6,LINKSF
	ERRMSG	{RENAME FAILED ON LINKS.TMP}
	RELEAS	6,

	OPEN	5,DSK17
	ERRMSG	{OPEN FAILED ON DICT}
	MOVEI	A,'TMP'
	HRLZM	A,DICTF+1
	SETZM	DICTF+3
	LOOKUP	5,DICTF
	ERRMSG	{LOOKUP FAILED ON DICT.TMP PAGE 10}
	SETZM	DICTF+1
	SETZM	DICTF+2
	SETZM	DICTF+3
	RENAME	5,DICTF
	ERRMSG	{RENAME FAILED ON DICT.TMP}
	RELEAS	5,

	OPEN	7,DSK17
	ERRMSG	{OPEN FAILED ON WPRDS}
	MOVEI	A,'TMP'
	HRLZM	A,WORDSF+1
	SETZM	WORDSF+3
	LOOKUP	7,WORDSF
	ERRMSG	{LOOKUP FAILED ON WORDS.TMP PAGE 10}
	SETZM	WORDSF+1
	SETZM	WORDSF+2
	SETZM	WORDSF+3
	RENAME	7,WORDSF
	ERRMSG	{RENAME FAILED ON WORDS.TMP}
	RELEAS	7,
;FINISH OF PROGRAM,SUBROUTINE EXAMIN,SETFLG
FINISH:	CALL	[SIXBIT /RESET/]
	CALL	[SIXBIT /EXIT/]

;see if DICT2 entry is still valid
TEST3:	HLRZ	A,DICT2-2(DBOT)	;compare the last WORD pointer with the WORD
	HRRZ	B,MULKY		;pointer of MULKY
	HLRZ	B,DICT(B)
	CAME	B,A
	POPJ	P,		;if not the same,forget it
	MOVE	B,MULKY		;move them just in case
	MOVE	A,DICT(B)
	MOVEM	A,DICT2-2(DBOT)
	MOVE	A,DICT+1(B)
	MOVEM	A,DICT2-1(DBOT)
	POPJ	P,

MOV:	MOVE	A,DICT(DPTR)	;transfer two words in DICT to DICT2
	MOVEM	A,DICT2(DBOT)
	MOVE	A,DICT+1(DPTR)
	MOVEM	A,DICT2+1(DBOT)
	ADDI	DBOT,2
	SETOM	MOVED
	SETOM	OLMLFG
	POPJ	P,

GETBYT:	SOSG	IBUF+2			;number of bytes left to be read
	IN	2,			;input
	JRST	[ILDB CHAR,IBUF+1	;get a character
		JUMPE	CHAR,GETBYT	;get another if character is null
		POPJ	P,]		;return
	STATO	2,20000
	ERRMSG	{UNDEFINED ERROR IN INPUT BUFFERING}
	RELEAS	2,
	MOVEI	CHAR,"?"		;run out of input...insert a ?
	LSH	CHAR,=29		;rotate it to the correct filed
	MOVEM	CHAR,PARTS+1		;and move it to the parts
	JRST	NXTDCT

SETFG:	SETOM	OCFLG			;flag indicating whether OCCUR.DAT is present
	JRST	DCONT			;	or not.
;SUBROUTINE GETSRT,ERROR,PAUSE
GETSRT:	MOVEI	MAXW,5
GET3:	MOVE	A,PARTS(MAXW)	;store the first 5 words of the last SORTED word
	MOVEM	A,OLPART(MAXW)
	SOJG	MAXW,GET3

	MOVE	PPTR,[POINT 7,PARTS,35]
	MOVEI	MAXW,=20	;maximum word length
SNXTCH:	PUSHJ	P,GETBYT	;get a byte
	CAIN	CHAR,"@"
	JRST	ENDWRD		;end of a word
	CAIN	CHAR,CR
	JRST	FNDEND		;end of the entire MULT
	IDPB	CHAR,PPTR	;put the character in PARTS
	SOJG	MAXW,SNXTCH
FND4:	PUSHJ	P,GETBYT	;eat all the @'s from WORDS.SRT
	CAIN	CHAR,"@"
	JRST	ENDWRD
	CAIE	CHAR,CR
	JRST	FND4
FNDEND:	PUSHJ	P,GETBYT	;read until a LF appears
	CAIE	CHAR,LF
	JRST	FNDEND
	MOVEI	CHAR,"@"
FND3:	IDPB	CHAR,PPTR	;finish word with @'s
	TLNE	PPTR,760000
	JRST	FND3
	IDPB	CHAR,PPTR	;and make another word of @'s
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
	MOVEI	CHAR,0
	IDPB	CHAR,PPTR	;and then a null word
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
	IDPB	CHAR,PPTR
NUOUT:	MOVEI	MAXW,1
NUOUT2:	MOVE	CHAR,PARTS(MAXW)	;see if this has already been moved
	CAME	CHAR,OLPART(MAXW)
	JRST	OUT3
	CAME	CHAR,[ASCII /@@@@@/]
	AOJA	MAXW,NUOUT2
	SETOM	MOVED			;OLPART = first word. Set the flag
OUT4:	POPJ	P,
OUT3:	SOJLE	MAXW,OUT5
	MOVE	CHAR,PARTS(MAXW)
	TRNE	CHAR,176
OUT5:	SETZM	MOVED
	POPJ	P,

ENDWRD:	IDPB	CHAR,PPTR	;end of one of the words of the MULT
	TLNE	PPTR,760000	;finish word with @'s
	JRST	ENDWRD
END2:	IDPB	CHAR,PPTR	;and make another word of @'s
	TLNE	PPTR,760000
	JRST	END2
	MOVEI	MAXW,=20
	JRST	SNXTCH


PAUSE:	RELEAS	0,
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	MODIF

ERROR:	OUTSTR	[CRLFS:	ASCIZ /

/]
	OUTSTR	(A)
	OUTSTR	CRLFS
	MOVE	A,SAVEDA
	CALL	1,[SIXBIT /EXIT/]
	HALT	.
COUNTL:	MOVEI	LINCNT,0	;initialize the link count to zero

	HRRE	WPTR,DICT+1(DPTR);get the first link
	JUMPLE	WPTR,CNTDUN	;if zero we're done
CNTLIN:	ADDI	LINCNT,1	;not zero. increment count
	HLRZ	A,LINKS(WPTR);get next link
	SETZM	LINKS+1(WPTR)
	HRRZS	LINKS(WPTR)

	MOVE	WPTR,A	
	JUMPG	WPTR,CNTLIN	;if next pointer isn't zero, continue
CNTDUN:	MOVE	A,TOTCNM	;get the total count number
	ADDI	A,(LINCNT)	;add in this list
	MOVEM	A,TOTCNM	;move it back to memory
	MOVEM	KPTR,KPTRM

	MOVE	A,SPACES	;start to set up WORDS.DEL
	TRZ	A,40		;get rid of last space in preparation for the tab
	MOVEI	LINCNT+1,11	;tab
	ADDI	A,(LINCNT+1)	;add it into A
	IDIVI	LINCNT,=10	;divide the link count by 10.LINCNT+1 holds the remainder
	ADDI	LINCNT+1,60	;change it to ascii
	ROT	A,-7		;rotate A to make room for digit
	TRZ	A,40		;get rid of space
	ADDI	A,(LINCNT+1)	;add in the one's place
	JUMPE	LINCNT,CDUN3	;if LINCNT=0 then we're done
	ROT	A,-7		;rotate A around for next digit
	IDIVI	LINCNT,=10	;etc.
	ADDI	LINCNT+1,60
	TRZ	A,40
	ADDI	A,(LINCNT+1)
	JUMPE	LINCNT,CDONE0
	ADDI	LINCNT,60
	ROT	A,-7
	TRZ	A,40
	ADDI	A,(LINCNT)
CDUN00:	ROT	A,7		;rotate A back to correct position
CDONE0:	ROT	A,7
CDUN3:	ROT	A,7
	LSH	A,1		;plus one for the last bit
	MOVEM	A,DEL(DELPTR)	;put in WORDS.DEL
	ADDI	DELPTR,1	;add on to the pointer

	MOVE	KPTR,KPTRM
	SETZ	B,
NXTMWD:	MOVE	C,MULKY(B)
DEL6:	HLRZ	WPTR,DICT(C)	;get pointer to WORDS for the deleted word
DEL4:	MOVE	A,WORDS(WPTR)	;get first part
	TRNE	A,176		;end in @?
	JRST	EXDUN		;no
	TRNE	A,37400		;any more?
	JRST	DWRDUN		;no
	TRZ	A,40000		;yes...get rid of next @ sign.
	TDNE	A,MASK		;more?
	JRST	DWRDUN		;etc.
	TLZ	A,10
	TLNE	DIFP,1760
	JRST	DWRDUN
	TLZ	A,2000
	TLNN	A,37400
	TLZ	A,400000
	JRST	DWRDUN

EXDUN:	MOVEM	A,DEL(DELPTR)	;move part into WORDS.DEL
	ADDI	DELPTR,1	;increment pointers
	AOJA	WPTR,DEL4	;return for next part
DWRDUN:	MOVEM	A,DEL(DELPTR)	;end of word. move into WORDS.DEL
	ADDI	DELPTR,1	;increment pointers

	ADDI	B,1
	CAMG	B,KPTR
	JRST	NXTMWD
DUN2:	MOVEI	A,6424		;move in CRLF
	MOVEM	A,DEL(DELPTR)	;store
	ADDI	DELPTR,1
	MOVEM	DELPTR,DELPTM	;save pointer into WORDS.DEL
SAV2:	POPJ	P,
GETDCT:	SETZ	RPTR,	;initialize the retrieval pointer
	SETZ	A,
GETDC:	MOVE	B,MULKY(A)	;save the first 2 pointers
	MOVEM	B,OLMLKY(A)
	CAIE	A,1
	AOJA	A,GETDC
GETDC2:	JUMPLE	KPTR,PLAINW	;if KPTR= 0 then we want a completely new word
MLT:	MOVE	DPTR,MULKY(KPTR);otherwise ..get the current DPTR
	SETOM	MULFLG
	HLRZ	A,DICT+1(DPTR)	;try to get it's son
	JUMPN	A,GOTML1
	HRRZ	A,DICT+2(DPTR)	;try to get it's brother
	JUMPN	A,GOTML2
BACKUP:	SUBI	KPTR,1		;can't..look at the father of this word
	JUMPL	KPTR,NOMOR	;there is no father
	MOVE	DPTR,MULKY(KPTR)
	HRRZ	A,DICT+2(DPTR)	;try to get a brother to the father(uncle?)
	JUMPE	A,BACKUP	;try again
	JRST	GOTML2		;got one
GOTML1:	ADDI	KPTR,1		;make a new entry
GOTML2:	MOVEM	A,MULKY(KPTR)	;deposit the new entry
	HRRE	C,DICT+1(A)	;is this a stopping point?
	JUMPGE	C,GOTON		;yes
	HLRZ	C,DICT+1(A)	;no..get the son
	MOVE	A,C
	JRST	GOTML1		;and deposit him

NOMOR:	SETZM	MOVED		;done with that MULT
	SETOM	OLMLFG
	SETZM	MULFLG
	JRST	GETDC2

PLAINW:	JUMPL	KPTR,NXTONE	
	SETZ	KPTR,
	MOVE	A,MULKY(KPTR)
	SETZM	MULFLG
	HLRZ	C,DICT+1(A)	;try to get a son
	JUMPN	C,GETNXT	
NXTONE:	SETZ	KPTR,		;no son
	MOVE	A,MULKY(KPTR)	;increment the current pointer
	ADDI	A,2
	MOVEM	A,MULKY(KPTR)	;and deposit it
	MOVE	C,A
	HRRE	A,DICT+1(C)	;is it a valid stopping point?
	JUMPGE	A,GOTONE
	HLRZ	C,DICT+1(C)	;no. get the son
GETNXT:	ADDI	KPTR,1		;increment KPTR
	MOVEM	C,MULKY(KPTR)	;deposit the son
	SETOM	MULFLG
	MOVE	A,C
	HRRE	A,DICT+1(C)	;stopping place?
	JUMPGE	A,GOTONE	;yes
	HLRZ	C,DICT+1(C)	;no , get the son
	JRST	GETNXT
GOTONE:	SETZM	MULFLG	
	JUMPE	KPTR,GOTON
	SETOM	MULFLG
GOTON:	POPJ	P,

	END	MODIFY